home *** CD-ROM | disk | FTP | other *** search
/ PC Open 107 / PC Open 107 CD 1.bin / CD1 / INTERNET / EMAIL / pop file / setup.exe / $_1_ / Date / Format.pm next >
Encoding:
Perl POD Document  |  2003-06-09  |  9.9 KB  |  407 lines
  1. # Date::Format $Id: //depot/TimeDate/lib/Date/Format.pm#9 $
  2. #
  3. # Copyright (c) 1995-1999 Graham Barr. All rights reserved. This program is free
  4. # software; you can redistribute it and/or modify it under the same terms
  5. # as Perl itself.
  6.  
  7. package Date::Format;
  8.  
  9. use     strict;
  10. use     vars qw(@EXPORT @ISA $VERSION);
  11. require Exporter;
  12.  
  13. $VERSION = "2.22";
  14. @ISA     = qw(Exporter);
  15. @EXPORT  = qw(time2str strftime ctime asctime);
  16.  
  17. sub time2str ($;$$)
  18. {
  19.  Date::Format::Generic->time2str(@_);
  20. }
  21.  
  22. sub strftime ($\@;$)
  23. {
  24.  Date::Format::Generic->strftime(@_);
  25. }
  26.  
  27. sub ctime ($;$)
  28. {
  29.  my($t,$tz) = @_;
  30.  Date::Format::Generic->time2str("%a %b %e %T %Y\n", $t, $tz); 
  31. }
  32.  
  33. sub asctime (\@;$)
  34. {
  35.  my($t,$tz) = @_;
  36.  Date::Format::Generic->strftime("%a %b %e %T %Y\n", $t, $tz); 
  37. }
  38.  
  39. ##
  40. ##
  41. ##
  42.  
  43. package Date::Format::Generic;
  44.  
  45. use vars qw($epoch $tzname);
  46. use Time::Zone;
  47. use Time::Local;
  48.  
  49. sub ctime
  50. {
  51.  my($me,$t,$tz) = @_;
  52.  $me->time2str("%a %b %e %T %Y\n", $t, $tz); 
  53. }
  54.  
  55. sub asctime
  56. {
  57.  my($me,$t,$tz) = @_;
  58.  $me->strftime("%a %b %e %T %Y\n", $t, $tz); 
  59. }
  60.  
  61. sub _subs
  62. {
  63.  my $fn;
  64.  $_[1] =~ s/
  65.         %(O?[%a-zA-Z])
  66.        /
  67.                 ($_[0]->can("format_$1") || sub { $1 })->($_[0]);
  68.        /sgeox;
  69.  
  70.  $_[1];
  71. }
  72.  
  73. sub strftime 
  74. {
  75.  my($pkg,$fmt,$time);
  76.  
  77.  ($pkg,$fmt,$time,$tzname) = @_;
  78.  
  79.  my $me = ref($pkg) ? $pkg : bless [];
  80.  
  81.  if(defined $tzname)
  82.   {
  83.    $tzname = uc $tzname;
  84.  
  85.    $tzname = sprintf("%+05d",$tzname)
  86.     unless($tzname =~ /\D/);
  87.  
  88.    $epoch = timegm(@{$time}[0..5]);
  89.  
  90.    @$me = gmtime($epoch + tz_offset($tzname) - tz_offset());
  91.   }
  92.  else
  93.   {
  94.    @$me = @$time;
  95.    undef $epoch;
  96.   }
  97.  
  98.  _subs($me,$fmt);
  99. }
  100.  
  101. sub time2str
  102. {
  103.  my($pkg,$fmt,$time);
  104.  
  105.  ($pkg,$fmt,$time,$tzname) = @_;
  106.  
  107.  my $me = ref($pkg) ? $pkg : bless [], $pkg;
  108.  
  109.  $epoch = $time;
  110.  
  111.  if(defined $tzname)
  112.   {
  113.    $tzname = uc $tzname;
  114.  
  115.    $tzname = sprintf("%+05d",$tzname)
  116.     unless($tzname =~ /\D/);
  117.  
  118.    $time += tz_offset($tzname);
  119.    @$me = gmtime($time);
  120.   }
  121.  else
  122.   {
  123.    @$me = localtime($time);
  124.   }
  125.  $me->[9] = $time;
  126.  _subs($me,$fmt);
  127. }
  128.  
  129. my(@DoW,@MoY,@DoWs,@MoYs,@AMPM,%format,@Dsuf);
  130.  
  131. @DoW = qw(Sunday Monday Tuesday Wednesday Thursday Friday Saturday);
  132.  
  133. @MoY = qw(January February March April May June
  134.           July August September October November December);
  135.  
  136. @DoWs = map { substr($_,0,3) } @DoW;
  137. @MoYs = map { substr($_,0,3) } @MoY;
  138.  
  139. @AMPM = qw(AM PM);
  140.  
  141. @Dsuf = (qw(th st nd rd th th th th th th)) x 3;
  142. @Dsuf[11,12,13] = qw(th th th);
  143. @Dsuf[30,31] = qw(th st);
  144.  
  145. %format = ('x' => "%m/%d/%y",
  146.            'C' => "%a %b %e %T %Z %Y",
  147.            'X' => "%H:%M:%S",
  148.           );
  149.  
  150. my @locale;
  151. my $locale = "/usr/share/lib/locale/LC_TIME/default";
  152. local *LOCALE;
  153.  
  154. if(open(LOCALE,"$locale"))
  155.  {
  156.   chop(@locale = <LOCALE>);
  157.   close(LOCALE);
  158.  
  159.   @MoYs = @locale[0 .. 11];
  160.   @MoY  = @locale[12 .. 23];
  161.   @DoWs = @locale[24 .. 30];
  162.   @DoW  = @locale[31 .. 37];
  163.   @format{"X","x","C"} =  @locale[38 .. 40];
  164.   @AMPM = @locale[41 .. 42];
  165.  }
  166.  
  167. sub wkyr {
  168.     my($wstart, $wday, $yday) = @_;
  169.     $wday = ($wday + 7 - $wstart) % 7;
  170.     return int(($yday - $wday + 13) / 7 - 1);
  171. }
  172.  
  173. ##
  174. ## these 6 formatting routins need to be *copied* into the language
  175. ## specific packages
  176. ##
  177.  
  178. my @roman = ('',qw(I II III IV V VI VII VIII IX));
  179. sub roman {
  180.   my $n = shift;
  181.  
  182.   $n =~ s/(\d)$//;
  183.   my $r = $roman[ $1 ];
  184.  
  185.   if($n =~ s/(\d)$//) {
  186.     (my $t = $roman[$1]) =~ tr/IVX/XLC/;
  187.     $r = $t . $r;
  188.   }
  189.   if($n =~ s/(\d)$//) {
  190.     (my $t = $roman[$1]) =~ tr/IVX/CDM/;
  191.     $r = $t . $r;
  192.   }
  193.   if($n =~ s/(\d)$//) {
  194.     (my $t = $roman[$1]) =~ tr/IVX/M../;
  195.     $r = $t . $r;
  196.   }
  197.   $r;
  198. }
  199.  
  200. sub format_a { $DoWs[$_[0]->[6]] }
  201. sub format_A { $DoW[$_[0]->[6]] }
  202. sub format_b { $MoYs[$_[0]->[4]] }
  203. sub format_B { $MoY[$_[0]->[4]] }
  204. sub format_h { $MoYs[$_[0]->[4]] }
  205. sub format_p { $_[0]->[2] >= 12 ?  $AMPM[1] : $AMPM[0] }
  206. sub format_P { lc($_[0]->[2] >= 12 ?  $AMPM[1] : $AMPM[0]) }
  207.  
  208. sub format_d { sprintf("%02d",$_[0]->[3]) }
  209. sub format_e { sprintf("%2d",$_[0]->[3]) }
  210. sub format_H { sprintf("%02d",$_[0]->[2]) }
  211. sub format_I { sprintf("%02d",$_[0]->[2] % 12 || 12)}
  212. sub format_j { sprintf("%03d",$_[0]->[7] + 1) }
  213. sub format_k { sprintf("%2d",$_[0]->[2]) }
  214. sub format_l { sprintf("%2d",$_[0]->[2] % 12 || 12)}
  215. sub format_L { $_[0]->[4] + 1 }
  216. sub format_m { sprintf("%02d",$_[0]->[4] + 1) }
  217. sub format_M { sprintf("%02d",$_[0]->[1]) }
  218. sub format_q { sprintf("%01d",int($_[0]->[4] / 3) + 1) }
  219. sub format_s { 
  220.    $epoch = timegm(@{$_[0]}[0..5])
  221.     unless defined $epoch;
  222.    sprintf("%d",$epoch) 
  223. }
  224. sub format_S { sprintf("%02d",$_[0]->[0]) }
  225. sub format_U { wkyr(0, $_[0]->[6], $_[0]->[7]) }
  226. sub format_w { $_[0]->[6] }
  227. sub format_W { wkyr(1, $_[0]->[6], $_[0]->[7]) }
  228. sub format_y { sprintf("%02d",$_[0]->[5] % 100) }
  229. sub format_Y { sprintf("%04d",$_[0]->[5] + 1900) }
  230.  
  231. sub format_Z {
  232.  my $o = tz_local_offset(timelocal(@{$_[0]}[0..5]));
  233.  defined $tzname ? $tzname : uc tz_name($o, $_[0]->[8]);
  234. }
  235.  
  236. sub format_z {
  237.  my $t = timelocal(@{$_[0]}[0..5]);
  238.  my $o = defined $tzname ? tz_offset($tzname, $t) : tz_offset(undef,$t);
  239.  sprintf("%+03d%02d", int($o / 3600), abs(int($o % 3600)));
  240. }
  241.  
  242. sub format_c { &format_x . " " . &format_X }
  243. sub format_D { &format_m . "/" . &format_d . "/" . &format_y  }      
  244. sub format_r { &format_I . ":" . &format_M . ":" . &format_S . " " . &format_p  }   
  245. sub format_R { &format_H . ":" . &format_M }
  246. sub format_T { &format_H . ":" . &format_M . ":" . &format_S }
  247. sub format_t { "\t" }
  248. sub format_n { "\n" }
  249. sub format_o { sprintf("%2d%s",$_[0]->[3],$Dsuf[$_[0]->[3]]) }
  250. sub format_x { my $f = $format{'x'}; _subs($_[0],$f); }
  251. sub format_X { my $f = $format{'X'}; _subs($_[0],$f); }
  252. sub format_C { my $f = $format{'C'}; _subs($_[0],$f); }
  253.  
  254. sub format_Od { roman(format_d(@_)) }
  255. sub format_Oe { roman(format_e(@_)) }
  256. sub format_OH { roman(format_H(@_)) }
  257. sub format_OI { roman(format_I(@_)) }
  258. sub format_Oj { roman(format_j(@_)) }
  259. sub format_Ok { roman(format_k(@_)) }
  260. sub format_Ol { roman(format_l(@_)) }
  261. sub format_Om { roman(format_m(@_)) }
  262. sub format_OM { roman(format_M(@_)) }
  263. sub format_Oq { roman(format_q(@_)) }
  264. sub format_Oy { roman(format_y(@_)) }
  265. sub format_OY { roman(format_Y(@_)) }
  266.  
  267. sub format_G { int(($_[0]->[9] - 315993600) / 604800) }
  268.  
  269. 1;
  270. __END__
  271.  
  272. =head1 NAME
  273.  
  274. Date::Format - Date formating subroutines
  275.  
  276. =head1 SYNOPSIS
  277.  
  278.     use Date::Format;
  279.  
  280.     @lt = localtime(time);
  281.  
  282.     print time2str($template, time);
  283.     print strftime($template, @lt);
  284.  
  285.     print time2str($template, time, $zone);
  286.     print strftime($template, @lt, $zone);
  287.  
  288.     print ctime(time);
  289.     print asctime(@lt);
  290.  
  291.     print ctime(time, $zone);
  292.     print asctime(@lt, $zone);
  293.  
  294. =head1 DESCRIPTION
  295.  
  296. This module provides routines to format dates into ASCII strings. They
  297. correspond to the C library routines C<strftime> and C<ctime>.
  298.  
  299. =over 4
  300.  
  301. =item time2str(TEMPLATE, TIME [, ZONE])
  302.  
  303. C<time2str> converts C<TIME> into an ASCII string using the conversion
  304. specification given in C<TEMPLATE>. C<ZONE> if given specifies the zone
  305. which the output is required to be in, C<ZONE> defaults to your current zone.
  306.  
  307.  
  308. =item strftime(TEMPLATE, TIME [, ZONE])
  309.  
  310. C<strftime> is similar to C<time2str> with the exception that the time is
  311. passed as an array, such as the array returned by C<localtime>.
  312.  
  313. =item ctime(TIME [, ZONE])
  314.  
  315. C<ctime> calls C<time2str> with the given arguments using the
  316. conversion specification C<"%a %b %e %T %Y\n">
  317.  
  318. =item asctime(TIME [, ZONE])
  319.  
  320. C<asctime> calls C<time2str> with the given arguments using the
  321. conversion specification C<"%a %b %e %T %Y\n">
  322.  
  323. =back
  324.  
  325. =head1 MULTI-LANGUAGE SUPPORT
  326.  
  327. Date::Format is capable of formating into several languages, these are
  328. English, French, German and Italian. Changing the language is done via
  329. a static method call, for example
  330.  
  331.     Date::Format->language('German');
  332.  
  333. will change the language in which all subsequent dates are formatted.
  334.  
  335. This is only a first pass, I am considering changing this to be
  336.  
  337.     $lang = Date::Language->new('German');
  338.     $lang->time2str("%a %b %e %T %Y\n", time);
  339.  
  340. I am open to suggestions on this.
  341.  
  342. =head1 CONVERSION SPECIFICATION
  343.  
  344. Each conversion specification  is  replaced  by  appropriate
  345. characters   as   described  in  the  following  list.   The
  346. appropriate  characters  are  determined  by   the   LC_TIME
  347. category of the program's locale.
  348.  
  349.     %%    PERCENT
  350.     %a    day of the week abbr
  351.     %A    day of the week
  352.     %b    month abbr
  353.     %B     month
  354.     %c    MM/DD/YY HH:MM:SS
  355.     %C     ctime format: Sat Nov 19 21:05:57 1994
  356.     %d     numeric day of the month, with leading zeros (eg 01..31)
  357.     %e     numeric day of the month, without leading zeros (eg 1..31)
  358.     %D     MM/DD/YY
  359.     %G    GPS week number (weeks since January 6, 1980)
  360.     %h     month abbr
  361.     %H     hour, 24 hour clock, leading 0's)
  362.     %I     hour, 12 hour clock, leading 0's)
  363.     %j     day of the year
  364.     %k     hour
  365.     %l     hour, 12 hour clock
  366.     %L     month number, starting with 1
  367.     %m     month number, starting with 01
  368.     %M     minute, leading 0's
  369.     %n     NEWLINE
  370.     %o    ornate day of month -- "1st", "2nd", "25th", etc.
  371.     %p     AM or PM
  372.     %P     am or pm (Yes %p and %P are backwards :)
  373.     %q    Quarter number, starting with 1
  374.     %r     time format: 09:05:57 PM
  375.     %R     time format: 21:05
  376.     %s    seconds since the Epoch, UCT
  377.     %S     seconds, leading 0's
  378.     %t     TAB
  379.     %T     time format: 21:05:57
  380.     %U     week number, Sunday as first day of week
  381.     %w     day of the week, numerically, Sunday == 0
  382.     %W     week number, Monday as first day of week
  383.     %x     date format: 11/19/94
  384.     %X     time format: 21:05:57
  385.     %y    year (2 digits)
  386.     %Y    year (4 digits)
  387.     %Z     timezone in ascii. eg: PST
  388.     %z    timezone in format -/+0000
  389.  
  390. C<%d>, C<%e>, C<%H>, C<%I>, C<%j>, C<%k>, C<%l>, C<%m>, C<%M>, C<%q>,
  391. C<%y> and C<%Y> can be output in Roman numerals by prefixing the letter
  392. with C<O>, e.g. C<%OY> will output the year as roman numerals.
  393.  
  394. =head1 AUTHOR
  395.  
  396. Graham Barr <gbarr@pobox.com>
  397.  
  398. =head1 COPYRIGHT
  399.  
  400. Copyright (c) 1995-1999 Graham Barr. All rights reserved. This program is free
  401. software; you can redistribute it and/or modify it under the same terms
  402. as Perl itself.
  403.  
  404. =cut
  405.  
  406.  
  407.